perm filename MPOLD.F4[XX,LCS] blob sn#233037 filedate 1976-08-22 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C00011 ENDMK
C⊗;
C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C *** READS DATA FROM DSK FOR VARIOUS THINGS.

	IMPLICIT INTEGER(A-Q,S-Z)
	REAL DIS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2,TOTAL
	COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C					   ↓↓↓↓↓ V IS FOR READIN ONLY
	COMMON  /XRN/RN(3000),V(1000) /ALF/INP(72),ML
	1 /STF/RSTFAC(-3/4),RSTJ2  /POSI/STFF(-3/4),JJ2,POS
	1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
	1/PLTR/PLT,RHT,DIS
	EQUIVALENCE (J3,JQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(POS,IPOS)
	1,(R6,RJQ(4)),(R7,RJQ(5)),(R9,RJQ(7)),(J10,JQ(8)),(RX3,RJQ(20))
	1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
	DATA IP/'P'/,FA1/'( A1)'/

	ITMS=0
	CALL SEGFIX
C  TO ENABLE MULTIPLE USE OF UPPER SEGMENT (TVR)
	TOTAL=0
	RPLT=-999.
C  RPLT WILL BE FOR HEAVY STAFF LINES.
23	TYPE 21
21	FORMAT(' RESET BOTTOM? '$)
	ACCEPT FA1,K
	IF(K.EQ.'A')GO TO 124
	IF(K.EQ.'P')GO TO 123
C  TYPE 'P' FOR PRIM FONT ONLY. 'A' FOR ALL, IF RESET IS NEEDED.
	GO TO 24
123	JFONT=-1
	GO TO 23
124	JFONT=0
	GO TO 23
24	IF(K.EQ.'N')GO TO 22
C 'Y' OR <CR>=ABSOLUTE LOW POINT OF FILE WILL BE AT
C STARTING PEN POS.
C 'N'= BOTTOM OF STAFF 0 WILL BE AT STARTING PEN POS.
	TOP2=-999
	RNOMOV=0
22	I1=0
C  RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
2	TOP=-999
	BOT=999
20	PLT=0
	PLOTIT=0
CC	PWDS(1)=1.
	EDX=-1
CC	DO 1402 K=-3,4
CC1402	RSTFAC(K)=1.
	M=1
CC	ITEM=0
CC	I=1
	GO TO 5504


11	CALL NOTWRT
57	IF(PLT)GO TO 6120
	ITEM=ITEM+1
	IF(EDX.EQ.-1)GO TO 77
	IF(M.LT.I)GO TO 6120
77	IF(PLOTIT.EQ.-2)GO TO 2311
CZZ	PWDS(ITEM+1)=I

5504	IF(I1.EQ.IP)GO TO 2311
	I1=IP
	INP(2)='X'
311	JA=0
CC	IF(I1.NE.IP)GO TO 85
2311	CALL PLTCMD
	IF(INP(2).EQ.-1)GO TO 30
	IF(PLOTIT.EQ.0)GO TO 3005
	I1=IP
	PLOTIT=-1
C  'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE

6531	M=1
	EDX=-1
	DO 5532 K=1,9
5532	JQ(K)=RJQ(K)
CC590	IF(PLOTIT.EQ.-1)GO TO 121
	IF(PLOTIT.EQ.-1)GO TO 5121
590	I1=0
C TO RUN THROUGH DATA.
CC243	R2=0
CC	R3=0
CC	R4=0
	TOP=-999
	BOT=999
C  GOES TO PLOTTER
85	M=1
CC	I=PWDS(ITEM+1)
	ITEM=0
8852	PLT=1
	EDX=0
	GO TO 6120

30	A=TOTAL/200.0
	TYPE 300,A,ITMS
	CALL PLOT(0,0,99)
C  THE END OF THE DATA
300	FORMAT(F7.2,' INCHES',I,' ITEMS')

60	J2=R2
	IF(J2.LT.5)GO TO 16
	IF(J2.GT.-4)GO TO 16
	TYPE 160,J2
	GO TO 57
160	FORMAT(' ILLEGAL STAFF# ',I4)
16	RSTJ2=RSTFAC(J2)
5541	POS=STFF(J2)
	IF(JA.NE.16)GO TO 61
	IF(R5.GE.100)R5=R5-100
C >100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEPPPARTS.c
	IF(J10.NE.1)GO TO 62
	R3=RWD3
C  POSITIONS TEXT ITEMS.
62	RWD3=R5*RSTJ2*R9+R3
61	RX3=R3
	J3=ROFF(RHORZ(R3))
C  LINE IS DIVIDED INTO 200 POINTS.
	CALL CENTX
C  SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
	R3=J3
	IF(JA.LE.2)GO TO 11
551	GO TO(11,11,68,25,67, 625,116,125,11,69, 68,67),JA
	GO TO (116,81,80),JA-15
C  FOR 16,17,18 (WORDS, KSIG, METER)
	TYPE 5700,JA
5700	FORMAT(' UNKNOWN CODE=',I3)
	GO TO 57
C TRAP FOR UNKNOWN CODE #S (SUCH AS 99 - FOR "NO KSIG".

69	CALL MAKNUM(R5)
	GO TO 57

68	CALL CLEFS
	GO TO 57

67	CALL SLUR
	GO TO 57

116	CALL ALPHA
	GO TO 57

81	CALL KSIG
	GO TO 57

80	CALL METER
	GO TO 57

125	IF(R2.EQ.0)RMOV=R8
625	CALL BMSTF
C BEAMS AND STAVES
	GO TO 57

25	CALL ITMSUB
C   BAR LINES AND SEVERAL OTHER KINDS OF LINES.
	GO TO 57

CC3005	REWIND 21
C  GUARDS AGAINST LOSSAGE!
3005	IF(RPLT.EQ.-999.)RPLT=R9
C R9=1 FOR HEAVY STAFF LINES. (FOR XGP)
	PLOTIT=-2
CC	CALL IFILE(21,NAME)
	CALL GETFI2(NAME,-1)
C  JUMP TO READ BIG FILES
CC2200	J=ITEM+1
	CALL FASTI2(RSTFAC,128)
	CALL FASTI2(PWDS,JJ2)
	CALL FASTI2(RN,IPOS)
	ITEM=JJ2-2
	ITMS=ITMS+ITEM
	I=IPOS
CC2202	READ(21),ITEM,I,(PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1)
CC	1 ,JA,(V(K),K=1,JA),JA,(V(K),K=1,JA),RSTFAC,STFF
CC	READ(21,END=2203)RSTFAC,STFF
2203	IF(I.LE.2000)GO TO 590
	TYPE 4202,Y
	STOP
4202	FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
121	IF(PLOTIT.EQ.0)GO TO 5504
5121	CALL PLTSRT
C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
	PLT=-1
	IF(RPLT.NE.0)PLT=-2
C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
CC	IF(R2.EQ.0)R2=1.
	CALL NOZERO(R2)
	DIS=R2*1.24
CXX	IF(R3.EQ.0)R3=R2
	RHT=R3*1.2
C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
	A=BOT*RHT
	BOT=-A
	TOTAL=TOTAL+BOT+TOP*RHT
CX	IXGP=100+BOT
	IF(TOP2.EQ.-999)GO TO 8121
	BOT=BOT+TOP2
	IF(TOP2.EQ.0)BOT=0
	A=BOT
	GO TO 9121
8121	RNOMOV=0
9121	IF(R7.EQ.0)R7=RMOV
C RMOV HAS INCHES FROM P8 OF STAFF 0.
	IF(RNOMOV.GT.1)BOT=RNOMOV
	RNOMOV=R6+R7*200.*R3
	RMOV=0
C  R6=1 FOR NO MOVE AT END.  R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
C (J4) P4=1 FOR XGP OUTPUT
	IF(J5.NE.0)GO TO 6120
C  MOVES 0 POINT OVER EACH TIME.
6121	CALL PLOT(0,IFIX(BOT),-3)
C  MOVES PLOTTER UP IF P5=0.

C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
6120	IF(M.GE.I)GO TO 7120
	CALL RUNTHR(M)
	GO TO 60

7120	M=1
71201 	A=50.*RHT
	TOP=TOP*RHT
	IF(RNOMOV.EQ.0)GO TO 7122
	A=0
7121	IF(RNOMOV.LE.1)GO TO 7123
	A=RNOMOV
	TOTAL=TOTAL+A-TOP
	GO TO 7123
7122	TOTAL=TOTAL+A
	A=A+TOP
7123	CALL PLOT(0,IFIX(A),3)
	IF(RNOMOV.EQ.1)GO TO 20
C  PRESERVES TOP AND BOT IF RNOMOV
	TOP=A
	TOP2=TOP
	GO TO 2
C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
C  MOVES PLOTTER UP
C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.

	END